Info = "MSEExport.ExExport,SDK sample filter Microsoft Excel File,0,10,xls,xls"
End Property
Public Function Initialize(ByVal ThisFilter As Object) As Boolean
Initialize = True
End Function
Public Function WriteSetup(ByVal ThisFilter As Object) As Boolean
' setup setting for our filter
'MsgBox "Not implemented yet. " & vbCrLf & "Add your code here !"
MsgBox "Not implemented. " & vbCrLf & "You can add the code yourself.", , "XLS file export"
End Function
Public Function WriteFlat(ByVal FileName As String, ByVal Aspect As Long, ByVal Graphics As Object, Optional Query As Variant) As Long
On Error GoTo ExcelWontInit
' Create Microsoft Excel application
Set ExApp = CreateObject("Excel.Application")
Set pWbs = ExApp.Workbooks
' create new workbook
Set pWb = pWbs.Add
Set pWs = pWb.Worksheets(1) '.Add
Set Grs = Graphics
nGraphicsCount = Grs.Count
' fill timesheet with graphic's data
Call Fill_Sheet(pWs, "Graphic's properties")
Set Grs = Nothing
pWb.SaveAs FileName ', , , , , , xlShared
pWb.Close
pWbs.Close
ExApp.Quit
Set pWs = Nothing
Set pWb = Nothing
Set pWbs = Nothing
Set ExApp = Nothing
Exit Function
ExcelWontInit:
MsgBox "Can't initiaize Excel Application. Probably there is not Excel installed !"
MsgBox Err.Description
Err.Clear
If Not ExApp Is Nothing Then
ExApp.Quit
End If
Set pWs = Nothing
Set pWb = Nothing
Set pWbs = Nothing
Set ExApp = Nothing
End Function
Public Function PreviewFlat(ByVal ThisFilter As Object, ByVal FileName As String, ByVal WidthA As Long, ByVal HeightA As Long, Description As String, Thumbnail As Variant) As Long
PreviewFlat = -1
End Function
Public Function CheckFlat(ByVal ThisFilter As Object, ByVal FileName As String, ByVal Aspect As Long, ByVal Query As Variant) As Long
End Function
Public Property Get LastError() As String
Attribute LastError.VB_Description = "Get"
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.LastError
LastError = mvarLastError
End Property
' GetInfo: return the filter's info string
' Our info string is "MSEExport.Excel,Microsoft Excel File,0,10,xls,xls", stored in the DLL's
' resource.
' The info string contains the following fields, delimited by commas:
' Field Name Value
' 1. Filter ID "MSEExport.Excel"
' the Filter ID must contains 32 symbols not more'
' otherwise your custom filter will not registered properly by turboCAD
' Used as the internal name (must be unique).
' Should be the same as the ProgID registered for the server.
' TurboCAD reserves names beginning with an asterisk.
' 2. File type string for common dialog "Microsoft Excel File";
' This string appears in Windows dialog file type combo box.
' 3. Document type handled by filter 0
' This should always be zero for automation filters.
' 4. Priority 10
' Arbitrary integer value used to determine search order for multiple filters which
' support the same document type and file extension.
' 5. Exported function name prefix "xls"
' Not used by automation filters, but a non-blank string must be supplied.
' 6-n. File extensions "xls"
' Used in common dialog and for matching.
Public Property Get Description() As String
Attribute Description.VB_Description = "Get"
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Description
Description = mvarDescription
End Property
Public Property Get ClassID() As String
Attribute ClassID.VB_Description = "Get"
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.ClassID
ClassID = mvarClassID
End Property
Private Sub Fill_Sheet(W As Worksheet, SheetName As String)
' declare array to store graphic's data
Dim InfoArray() As String
Dim i As Long
Dim j As Long
Dim Gr As Graphic
W.Name = SheetName '"Graphic's properties"
' adjust array size in accordance with count of graphics and count of graphic properties to be exported
' in this example we export values of 5 properties for each graphic
' so array is nGraphicsCount x 5
ReDim InfoArray(nGraphicsCount, 5)
' first row in this array store Property Name (Column name in Excel spreadsheet)